home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / aijournl / ai_oct86.arc / OBJECT1.LTG < prev    next >
Encoding:
Text File  |  1986-07-18  |  4.6 KB  |  151 lines
  1.  
  2.  
  3. Listing 1
  4. áááááááááááááááááá
  5. An Object-Oriented Prolog System
  6.  
  7. % object definitionì
  8. add_object(SuperClass,Object,ObjectMethods) :-ì
  9. ááááááááadd_methods(Object,ObjectMethods),ì
  10. áááááááálink(Object,SuperClass).
  11.  
  12. % definition of a new object - "compiles" object code to Prologì
  13. add_methods(_,[]) :- !.ì
  14. add_methods(Object,[(Head :- Body)|Rest]) :- !,ì
  15. ááááááááHead =.. [Predicate | Args],ì
  16. ááááááááPrologHead =.. [Predicate, Object | Args],ì
  17. ááááááááassert((PrologHead :- Body)),ì
  18. ááááááááfunctor(Object,ObjName,_),ì
  19. ááááááááassert(index(Object,ObjName,(Head :- Body))), % to allow inquiriesì
  20. ááááááááadd_methods(Object,Rest).ì
  21. add_methods(Object,[Method|Rest]) :-ì
  22. ááááááááMethod =.. [Predicate | Args],ì
  23. ááááááááHead =.. [Predicate, Object | Args],ì
  24. ááááááááassert(Head),ì
  25. ááááááááfunctor(Object,ObjName,_),ì
  26. ááááááááassert(index(Object,ObjName,Method)),   % to allow inquiriesì
  27. ááááááááadd_methods(Object,Rest).
  28.  
  29. % create a new isa linkì
  30. link(Object,SuperClass) :-ì
  31. ááááááááclause(isa(Object,SuperClass),true) -> true ;   % to avoid redundancyìèááááááááassert(isa(Object,SuperClass)).
  32.  
  33. create_root :-ì
  34. ááclause(index(obj,obj,_),_) -> true ;          % OK if root already thereì
  35. ááadd_methods(obj,ì
  36. áááááááá[description('an object')]).
  37.  
  38. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%ì
  39. % execution messageì
  40. send(Object,Message) :-ì
  41. ááááááááMessage =.. [Predicate | Args],ì
  42. ááááááááQuery =.. [Predicate, Object1 | Args],ì
  43. ááááááááisa_chain(Object,Object1),ì
  44. ááááááááclause(Query,Body) ->           % override dup methodsì
  45. áááááááácall(Body).
  46.  
  47. isa_chain(Object, Object).              % try the Object itself firstì
  48. isa_chain(Object1,Object3) :-           % get ancestorsì
  49. ááááááááisa(Object1,Object2),ì
  50. áááááááá\+Object1=Object2,              % to avoid redundancyì
  51. ááááááááisa_chain(Object2,Object3).
  52.  
  53. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  54.  
  55. % inquiry messages
  56.  
  57. % what exists?ì
  58. exists(Object) :-ì
  59. ááááááááindex(Object,_,_).
  60.  
  61. what_exists :-ì
  62. áááááááásetof(Object,exists(Object),Objects),ì
  63. ááááááááwriteList(Objects).
  64.  
  65. % what objects exist with ObjectName? (in case you forget parameters)ì
  66. object_name(ObjectName) :-ì
  67. áááááááá(    index(Object,ObjectName,_),ì
  68. áááááááááááááwrite(Object), nl,ì
  69. ááááááááááááásend(Object,description(What)),ì
  70. ááááááááááááánl, write(What), nl, failì
  71. áááááááá;    trueì
  72. áááááááá).
  73.  
  74. % what are the methods of Object?ì
  75. methods(Object) :-ì
  76. áááááááásetof(Method,ObjName^index(Object,ObjName,Method),Methods),ì
  77. ááááááááwriteList(Methods).
  78.  
  79. writeList([]) :- !, nl.ì
  80. writeList([Head|Rest]) :-ì
  81. áááááááánl, write(Head), nl,ì
  82. ááááááááwriteList(Rest).
  83.  
  84. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%ì
  85. % deletions and unlinking
  86. è
  87. % remove the links for Objectì
  88. unlink(Object) :-ì
  89. áááááááá(    retract(isa(Object,_)),ì
  90. áááááááááááááfailì
  91. áááááááá;    retract(isa(_,Object)),ì
  92. áááááááááááááfailì
  93. áááááááá;    trueì
  94. áááááááá).
  95.  
  96. % remove a particular linkì
  97. unlink(Object,SuperClass) :-ì
  98. áááááááá(    retract(isa(Object,SuperClass)),ì
  99. áááááááááááááfailì
  100. áááááááá;    trueì
  101. áááááááá).
  102.  
  103. % revise the definition of Objectì
  104. redefine_object(SuperClass,Object,Methods) :-ì
  105. ááááááááremove_object(Object),ì
  106. ááááááááadd_object(SuperClass,Object,Methods).
  107.  
  108. %%% examples:ì
  109. add_circuit_objs :-ì
  110. áácreate_root,ì
  111. ááadd_object(obj,circuit,[]),ì
  112. ááadd_object(circuit,gate,[]),ì
  113. ááadd_object(gate,and_gate(In1,In2),ì
  114. áááááááá[(output(O) :- In1=1, In2=1 -> O=1 ; O=0),ì
  115. áááádescription('an and_gate with Boolean inputs: Input1, Input2') ] ),ì
  116. ááadd_object(gate,or_gate(In1,In2),ì
  117. áááááááá[(output(O) :- In1=0, In2=0 -> O=0 ; O=1),ì
  118. áááádescription('an or_gate with Boolean inputs: Input1, Input2') ] ),ì
  119. ááadd_object(gate,not_gate(In1),ì
  120. áááááááá[(output(O) :- In1=1 -> O=0 ; O=1),ì
  121. áááádescription('a not_gate with Boolean inputs: Input1') ] ),ì
  122. ááadd_object(circuit,circuit1(In1,In2),ì
  123. áááááááá[(output(O) :-  send(not_gate(In1),output(Not1)),ì
  124. áááááááááááááááááááááááásend(not_gate(In2),output(Not2)),ì
  125. áááááááááááááááááááááááásend(or_gate(Not1,Not2),output(O)) ),ì
  126. áááádescription('a circuit with Boolean inputs: Input1, Input2') ] ).
  127.  
  128. /******************* sample log of a Prolog session:
  129.  
  130. Quintus Prolog Release 2.0 (Sun)ì
  131. Copyright (C) 1986, Quintus Computer Systems, Inc.  All rights reserved.
  132.  
  133. | ?- compile(oops).ì
  134. [compilation completed]ì
  135. [12.600 sec 6632 bytes]ì
  136. | ?- add_circuit_objs.
  137.  
  138. yesì
  139. | ?- send(circuit1(1,0),output(Out)).
  140.  
  141. èOut = 1
  142.  
  143. | ?- send(circuit1(0,1),output(Out)).
  144.  
  145. Out = 1
  146.  
  147. | ?- send(circuit1(1,1),output(Out)).
  148.  
  149. Out = 0
  150.  
  151. | ?- halt.ì
  152. ********************************************************************/
  153.